home *** CD-ROM | disk | FTP | other *** search
/ MacWorld UK 2000 March / MW_UK_2000_03.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / browserMode.tcl < prev    next >
Encoding:
Text File  |  1999-11-17  |  10.7 KB  |  360 lines  |  [TEXT/ALFA]
  1. #=============================================================================
  2. # Browser mode.
  3. # 
  4. # Alpha cannot do batch searches without this file
  5. #=============================================================================
  6.  
  7. alpha::mode Brws 1.1.1 dummyBrws 
  8.  
  9. namespace eval browse {}
  10.  
  11. Bind '\r'    browse::Goto  Brws
  12. Bind enter    browse::Goto  Brws
  13. ascii 0x3      browse::Goto  Brws
  14. Bind down     browse::Down Brws
  15. Bind up     browse::Up   Brws
  16. Bind 'n' <z>    browse::Down Brws
  17. Bind 'p' <z>    browse::Up   Brws
  18. ascii 0x20    browse::Down Brws
  19. ascii 0x8    browse::Up   Brws
  20. # this was below.  do we need it?
  21. Bind 'c' <Cz>    browse::Goto
  22.  
  23. proc dummyBrws {} {}
  24.  
  25. # Set this to 1 to test dynamic code
  26. set browse::enableDynamic 0
  27.  
  28. proc browse::Up {} {
  29.     set limit [nextLineStart [nextLineStart [minPos]]]
  30.     if {[pos::compare [getPos] > $limit]} {
  31.     set limit [pos::math [getPos] - 1]
  32.     }
  33.     select [lineStart $limit] [nextLineStart $limit]
  34. }
  35.  
  36. proc browse::Down {} {
  37.     set pos [getPos]
  38.     if {[pos::compare $pos < [nextLineStart [minPos]]]} {
  39.     set pos [nextLineStart [minPos]]
  40.     }
  41.     if {[pos::compare [nextLineStart $pos] < [maxPos]]} {
  42.     select [nextLineStart $pos] [nextLineStart [nextLineStart $pos]]
  43.     }
  44. }
  45.  
  46. proc nextPrevMatch {{dir 1} {wname "*Batch Find*"}} {
  47.     set wins [winNames]
  48.     set res [lsearch $wins $wname]
  49.     if {$res < 0} {
  50.     set res [lsearch -regexp $wins {\*.*\*}]
  51.     if {$res < 0} return
  52.     }
  53.     set win [lindex $wins $res]
  54.     bringToFront $win
  55.     if {$dir} {
  56.     browse::Down
  57.     } else {
  58.     browse::Up
  59.     }
  60.     browse::Goto
  61.     dispErr $win
  62. }
  63.  
  64. proc nextMatch {{wname "*Batch Find*"}} {
  65.     nextPrevMatch 1 $wname
  66. }
  67.  
  68. proc prevMatch {{wname "*Batch Find*"}} {
  69.     nextPrevMatch 0 $wname
  70. }
  71.  
  72. proc dispErr {{win "* Compiler Errors *"}} {
  73.     if {[string length $win]} {
  74.     set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  75.     if {[regexp {(Line.*)∞} $text dummy sub]} {
  76.         message "$sub"
  77.     }
  78.     }
  79. }
  80.         
  81.  
  82. ##############################################################################
  83. #  To be used in the windows created by "matchingLines" or by batch searches.
  84. #
  85. #  With the cursor positioned in a line corrsponding to a match, 
  86. #  go back and select the line in the original file that 
  87. #  generated this match.  (Like emacs 'Occur' functionality)
  88. #
  89. proc browse::Goto {} {
  90.     global browse::GotoProc
  91.     foreach pat [array names browse::GotoProc] {
  92.     if {[string match $pat [win::CurrentTail]]} {
  93.         [set browse::GotoProc($pat)]
  94.         return
  95.     }
  96.     }
  97.     global tileHeight tileWidth tileTop tileLeft tileHeight \
  98.       errorHeight errorDisp tileMargin
  99.     set loc [getPos]
  100.     set ind1 -1
  101.     while {$ind1 < 0} {
  102.     set text [getText [lineStart $loc] [nextLineStart $loc]]
  103.     set ind1 [string first "∞" $text]
  104.     set loc [nextLineStart $loc]
  105.     if {[pos::compare $loc == [maxPos]]} {break}
  106.     }
  107.     set ind2 [string last "∞" $text]
  108.     if {$ind1 == $ind2} {
  109.     set fname [string trim [string range $text $ind1 end] "∞\r\n"]
  110.     set msg ""
  111.     } else {
  112.     set tmp [string trim [string range $text 0 $ind2] "∞\r\n"]
  113.     if {[string last "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞" $tmp] < 0} {
  114.         set fname [string trim [string range $text $ind2 end] "∞\r\n"]
  115.         set msg ""
  116.     } else {
  117.         set ind1 [string last "∞" $tmp]
  118.         set fname [string trim [string range $text $ind1 $ind2] "∞\r\n"]
  119.         set msg [string trim [string range $text $ind2 end] "∞\r\n"]
  120.     }
  121.     }
  122.     set loc [getPos]
  123.     set line -1
  124.     while {1} {
  125.     if {[regexp {Line ([0-9]+):} $text "" line]} {break}
  126.     set text [getText [lineStart $loc] [nextLineStart $loc]]
  127.     set loc [pos::math [lineStart $loc] - 1]
  128.     if {[pos::compare $loc <= [minPos]]} {
  129.         # It's a browse window without line numbers, since we've
  130.         # backed up to the top of the window.
  131.         set line -1
  132.         break
  133.     }
  134.     }
  135.     
  136.     set top $tileTop
  137.     set geo [getGeometry]
  138.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  139.       || ([lindex $geo 3] != $errorHeight) } {
  140.     moveWin $tileLeft $top
  141.     sizeWin $tileWidth $errorHeight
  142.     }
  143.     set mar $tileMargin
  144.     incr top [expr {$errorHeight + $mar}]
  145.     if {[browse::OpenWindow $fname]} {
  146.     edit -c -w -g $tileLeft $top $tileWidth $errorDisp $fname
  147.     set geo [getGeometry]
  148.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  149.       || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  150.         sizeWin $tileWidth $errorDisp
  151.         moveWin $tileLeft $top
  152.     }
  153.     } else {
  154.     if {![string match "*Link*" \
  155.       [getText [minPos] [nextLineStart [minPos]]]]} {
  156.         alertnote "File \"$fname\" not found." 
  157.     }
  158.     return
  159.     }
  160.     if {$line >= 0} {
  161.     set pos [rowColToPos $line 0]
  162.     select $pos [nextLineStart $pos]
  163.     }
  164.     message $msg
  165. }
  166.  
  167. proc browse::OpenWindow {fname} {
  168.     global tileHeight tileWidth tileTop tileLeft tileHeight \
  169.       errorHeight errorDisp tileMargin
  170.     if {[file exists $fname]} {
  171.     set top $tileTop
  172.     set mar $tileMargin
  173.     incr top [expr {$errorHeight + $mar}]
  174.     edit -c -w -g $tileLeft $top $tileWidth $errorDisp $fname
  175.     set geo [getGeometry]
  176.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  177.       || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  178.         sizeWin $tileWidth $errorDisp
  179.         moveWin $tileLeft $top
  180.     }
  181.     return 1
  182.     } else {
  183.     return 0
  184.     }
  185. }
  186.  
  187. set browse::lastMatchingLines ""
  188.  
  189. proc matchingLines {{reg ""} {for 1} {ign 1} {word 0} {regexp 1}} {
  190.     global browse::lastMatchingLines
  191.     
  192.     if {![string length $reg] && \
  193.       [catch {prompt "Regular expression:" [set browse::lastMatchingLines]} reg]} return
  194.     set browse::lastMatchingLines $reg
  195.     if {![string length $reg]} return
  196.     if {!$regexp} {
  197.     set reg [quote::Regfind $reg]
  198.     }
  199.     if {$word} {
  200.     set reg "^.*\\b$reg\\b.*$"
  201.     } else {
  202.     set reg "^.*$reg.*$"
  203.     }
  204.     set pos [expr {$for ? [minPos] : [getPos]}]
  205.     set fileName [stripNameCount [win::Current]]
  206.     set matches 0
  207.     browse::Start {* Matching Lines *} \
  208.       "%d matching lines (<cr> to go to match)\r-----" 
  209.     while {![catch {search -s -f 1 -r 1 -i $ign -- $reg $pos} mtch]} {
  210.     browse::Add $fileName [eval getText $mtch] \
  211.       [lindex [posToRowCol [lindex $mtch 0]] 0] 0
  212.     set pos [lindex $mtch 1]
  213.     incr matches
  214.     }
  215.     browse::Complete
  216. }
  217.  
  218. ## 
  219.  # -------------------------------------------------------------------------
  220.  # 
  221.  # "grepsToWindow" --
  222.  # 
  223.  #  'args' is a list of items
  224.  # -------------------------------------------------------------------------
  225.  ##
  226. proc grepsToWindow {title args} {
  227.     global tileLeft tileTop tileWidth tileHeight errorHeight
  228.     win::SetProportions
  229.     new -n $title -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws \
  230.       -tabsize 8 -info [join $args ""]
  231.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  232.     message ""
  233. }
  234.  
  235. ## 
  236.  # -------------------------------------------------------------------------
  237.  # 
  238.  # "browse::Format" --
  239.  # 
  240.  #  Can be used by external code to ensure browse information is in an
  241.  #  acceptable format, and to simplify external code.
  242.  # -------------------------------------------------------------------------
  243.  ##
  244. proc browse::Format {file match line {withname 1}} {
  245.     if {$withname} {
  246.     set l [expr {40 - [string length [file tail $file]]}]
  247.     append res "\"[file tail $file]\"; " [format "%$l\s" ""] " "
  248.     } else {
  249.     regsub -all "\t" $match "  " match
  250.     }
  251.     append res [format "Line %d:\r" $line] $match \
  252.       "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$file"
  253.     return $res
  254. }
  255.  
  256. proc browse::RedoCount {} {
  257.     global browse::prefix browse::count
  258.     replaceText [minPos] [pos::math [minPos] + [string length [format [set browse::prefix] 1]]] \
  259.       [format [set browse::prefix] [set browse::count]]
  260. }
  261.  
  262. proc browse::Complete {} {
  263.     global browse::lines browse::none browse::haveWindow browse::count
  264.     if {[string length [set browse::haveWindow]]} {
  265.     bringToFront [set browse::haveWindow]
  266.     browse::RedoCount
  267.     goto [minPos]
  268.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  269.     setWinInfo read-only 1
  270.     return 0
  271.     } else {
  272.     if {[set browse::count]} {
  273.         browse::createWindow
  274.         setWinInfo read-only 1
  275.         select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  276.         return 0
  277.     } else {
  278.         beep
  279.         message [set browse::none]
  280.         return 1
  281.     }
  282.     }
  283. }
  284.  
  285. proc browse::createWindow {} {
  286.     global tileLeft tileTop tileWidth tileHeight errorHeight \
  287.       browse::lines browse::title browse::prefix browse::haveWindow \
  288.       browse::backGround browse::count
  289.     if {[set browse::backGround]} {set w [win::Current]}
  290.     win::SetProportions
  291.     set browse::haveWindow [new -n [set browse::title] \
  292.       -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws \
  293.       -tabsize 8 -shell 1 \
  294.       -text "[format [set browse::prefix] [set browse::count]]\r[join [set browse::lines] \r]"]
  295.     set browse::lines {}
  296.     if {[set browse::backGround]} {bringToFront $w}
  297.     message ""
  298. }
  299.  
  300. proc browse::updateWindow {} {
  301.     global browse::haveWindow browse::lines
  302.     goto -w [set browse::haveWindow] [maxPos -w [set browse::haveWindow]]
  303.     insertText -w [set browse::haveWindow] "[join [set browse::lines] \r]\r"
  304.     set browse::lines {}
  305. }
  306.  
  307. ## 
  308.  # -------------------------------------------------------------------------
  309.  # 
  310.  # "browse::Add" --
  311.  # 
  312.  #  Add the information to our list of browse items.  We can actually 
  313.  #  add these dynamically to the window if we like.
  314.  # -------------------------------------------------------------------------
  315.  ##
  316. proc browse::Add {file match line {withname 1}} {
  317.     global browse::lines browse::dynamic browse::haveWindow browse::count
  318.     lappend browse::lines [browse::Format $file $match $line $withname]
  319.     incr browse::count
  320.     if {[set browse::dynamic]} {
  321.     if {[string length [set browse::haveWindow]]} {
  322.         browse::updateWindow
  323.     } else {
  324.         browse::createWindow
  325.     }
  326.     }
  327. }
  328.  
  329. ## 
  330.  # -------------------------------------------------------------------------
  331.  # 
  332.  # "browse::Dynamic" --
  333.  # 
  334.  #  Somewhat experimental.
  335.  # -------------------------------------------------------------------------
  336.  ##
  337. proc browse::Dynamic {{backgd 0} {dyn 1}} {
  338.     global browse::dynamic browse::haveWindow browse::backGround browse::enableDynamic
  339.     if {![set browse::enableDynamic]} {return}
  340.     set browse::dynamic $dyn
  341.     set browse::haveWindow ""
  342.     set browse::backGround $backgd
  343. }
  344.  
  345. proc browse::Start {{theTitle {* Matching Lines *}} \
  346.   {thePrefix "%d matching lines (<cr> to go to match)\r-----"} \
  347.   {ifNone "No matches found."}} {
  348.     global browse::lines browse::title browse::prefix browse::none \
  349.       browse::dynamic browse::haveWindow browse::backGround browse::count
  350.     set browse::lines {}
  351.     set browse::title $theTitle
  352.     set browse::prefix $thePrefix
  353.     set browse::none $ifNone
  354.     set browse::dynamic 0
  355.     set browse::haveWindow ""
  356.     set browse::backGround 0
  357.     set browse::count 0
  358. }
  359.  
  360.